home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 3 / Gold Medal Software - Volume 3 (Gold Medal) (1994).iso / prog / pbc23c.arj / DWINMAN2.BAS < prev    next >
BASIC Source File  |  1994-03-13  |  5KB  |  139 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1994  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE SUB CalcAttr (BYVAL Foreground%, BYVAL Background%, VAttr%)
  8.    DECLARE SUB DelayV (BYVAL MilliSeconds%)
  9.    DECLARE SUB DReColorArea (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL VAttr%)
  10.    DECLARE SUB DXQPrint (BYVAL DSeg%, BYVAL DOfs%, St$, BYVAL Row%, BYVAL Column%, BYVAL VAttr%)
  11.  
  12. SUB DWindowMan2 (DSeg%, DOfs%, TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, FSt$, Fore%, Back%, Grow%, Shade%, TitleFore%, Title$)
  13.  
  14.    CalcAttr Fore%, Back%, VAttr%
  15.  
  16.    IF Grow% THEN
  17.       XD% = RightCol% - LeftCol% + 1
  18.       YD% = BottomRow% - TopRow% + 1
  19.       Y1% = TopRow% + YD% \ 2
  20.       X1% = LeftCol% + XD% \ 2
  21.       Y2% = BottomRow% - YD% \ 2
  22.       X2% = RightCol% - XD% \ 2
  23.       IF YD% > XD% THEN
  24.          XDelta% = 1
  25.          YDelta% = (YD% + XD% \ 2) \ XD%
  26.          IF YDelta% < 1 THEN YDelta% = 1
  27.       ELSE
  28.          YDelta% = 1
  29.          XDelta% = (XD% + YD% \ 2) \ YD%
  30.          IF XDelta% < 1 THEN XDelta% = 1
  31.       END IF
  32.       DO
  33.          Y1% = Y1% - YDelta%
  34.          IF Y1% < TopRow% THEN Y1% = TopRow%
  35.          X1% = X1% - XDelta%
  36.          IF X1% < LeftCol% THEN X1% = LeftCol%
  37.          Y2% = Y2% + YDelta%
  38.          IF Y2% > BottomRow% THEN Y2% = BottomRow%
  39.          X2% = X2% + XDelta%
  40.          IF X2% > RightCol% THEN X2% = RightCol%
  41.          GOSUB MakeWindow
  42.          IF Grow% > 0 THEN DelayV Grow%
  43.       LOOP UNTIL Y1% = TopRow% AND X1% = LeftCol% AND Y2% = BottomRow% AND X2% = RightCol%
  44.    ELSE
  45.       Y1% = TopRow%
  46.       X1% = LeftCol%
  47.       Y2% = BottomRow%
  48.       X2% = RightCol%
  49.       GOSUB MakeWindow
  50.    END IF
  51.  
  52.    EXIT SUB
  53.  
  54.  
  55.  
  56. MakeWindow:
  57.    tmp% = X2% - X1% + 1
  58.    IF Frame% AND 1 THEN
  59.       TopSt$ = STRING$(tmp%, "─")
  60.    ELSE
  61.       TopSt$ = STRING$(tmp%, "═")
  62.    END IF
  63.    MidSt$ = SPACE$(tmp%)
  64.    BotSt$ = TopSt$
  65.    SELECT CASE Frame%
  66.       CASE 1
  67.          TopSt$ = "┌" + TopSt$ + "┐"
  68.          MidSt$ = "│" + MidSt$ + "│"
  69.          BotSt$ = "└" + BotSt$ + "┘"
  70.       CASE 2
  71.          TopSt$ = "╔" + TopSt$ + "╗"
  72.          MidSt$ = "║" + MidSt$ + "║"
  73.          BotSt$ = "╚" + BotSt$ + "╝"
  74.       CASE 3
  75.          TopSt$ = "╓" + TopSt$ + "╖"
  76.          MidSt$ = "║" + MidSt$ + "║"
  77.          BotSt$ = "╙" + BotSt$ + "╜"
  78.       CASE 4
  79.          TopSt$ = "╒" + TopSt$ + "╕"
  80.          MidSt$ = "│" + MidSt$ + "│"
  81.          BotSt$ = "╘" + BotSt$ + "╛"
  82.       CASE 5
  83.          TopSt$ = STRING$(tmp% + 2, "▄")
  84.          MidSt$ = "▌" + MidSt$ + "▐"
  85.          BotSt$ = STRING$(tmp% + 2, "▀")
  86.       CASE 6
  87.          TopSt$ = STRING$(tmp% + 2, FSt$)
  88.          MidSt$ = FSt$ + MidSt$ + FSt$
  89.          BotSt$ = TopSt$
  90.       CASE 7
  91.          TopSt$ = LEFT$(FSt$, 1) + STRING$(tmp%, MID$(FSt$, 2, 1)) + MID$(FSt$, 3, 1)
  92.          MidSt$ = MID$(FSt$, 4, 1) + MidSt$ + MID$(FSt$, 5, 1)
  93.          BotSt$ = MID$(FSt$, 6, 1) + STRING$(tmp%, MID$(FSt$, 7, 1)) + RIGHT$(FSt$, 1)
  94.       CASE ELSE
  95.          TopSt$ = SPACE$(tmp% + 2)
  96.          MidSt$ = TopSt$
  97.          BotSt$ = TopSt$
  98.    END SELECT
  99.  
  100.    Row% = Y1% - 1
  101.    Col% = X1% - 1
  102.    IF LEN(Title$) > 0 AND LEN(TopSt$) >= 4 THEN
  103.       St$ = LEFT$(Title$, LEN(TopSt$) - 4)
  104.       MID$(TopSt$, 2) = "[" + St$ + "]"
  105.       DXQPrint DSeg%, DOfs%, TopSt$, Row%, Col%, VAttr%
  106.       CalcAttr TitleFore%, Back%, TAttr%
  107.       DXQPrint DSeg%, DOfs%, St$, Row%, Col% + 2, TAttr%
  108.    ELSE
  109.       DXQPrint DSeg%, DOfs%, TopSt$, Row%, Col%, VAttr%
  110.    END IF
  111.    FOR Row% = Y1% TO Y2%
  112.       DXQPrint DSeg%, DOfs%, MidSt$, Row%, Col%, VAttr%
  113.    NEXT
  114.    DXQPrint DSeg%, DOfs%, BotSt$, Y2% + 1, Col%, VAttr%
  115.  
  116.    Col% = X1% - 3
  117.    IF Shade% < 0 THEN
  118.       IF Shade% = -1 THEN
  119.          SAttr% = 0
  120.       ELSE
  121.          SAttr% = 8
  122.       END IF
  123.       IF Shade% < -2 THEN
  124.          DReColorArea DSeg%, DOfs%, Y1%, X2% + 2, Y2% + 1, X2% + 3, SAttr%
  125.          DReColorArea DSeg%, DOfs%, Y2% + 2, X1% + 1, Y2% + 2, X2% + 3, SAttr%
  126.       ELSE
  127.          DReColorArea DSeg%, DOfs%, Y1%, Col%, Y2% + 1, X1% - 2, SAttr%
  128.          DReColorArea DSeg%, DOfs%, Y2% + 2, Col%, Y2% + 2, X2% - 1, SAttr%
  129.       END IF
  130.    ELSEIF Shade% THEN
  131.       FOR Row% = Y1% TO Y2% + 1
  132.          DXQPrint DSeg%, DOfs%, "░░", Row%, Col%, Shade%
  133.       NEXT
  134.       DXQPrint DSeg%, DOfs%, STRING$(X2% - X1% + 3, "░"), Y2 + 2, Col%, Shade%
  135.    END IF
  136.    RETURN
  137.  
  138. END SUB
  139.